home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 27 / CU Amiga Magazine's Super CD-ROM 27 (1998)(EMAP Images)(GB)[!][issue 1998-10].iso / CUCD / Programming / JForth / JTools / Demos / demo_gsort < prev    next >
Encoding:
Text File  |  1991-12-30  |  3.8 KB  |  195 lines
  1. \ Demonstrate Batcher's Sort with graphics display.
  2. \
  3. \ Show random length rectangles then sort them.
  4. \
  5. \ Author: Phil Burk
  6. \ Copyright 1987  Delta Research
  7. \
  8. \ MOD: PLB 8/6/88 Display messages for shorter time.
  9. \ 00002 16-aug-91 mdh     Fix CHECK.DELAY to use >20 msec.  (min resolution
  10. \                         error too much effect on A3000...20 msec can
  11. \                         return right away.)
  12.  
  13. include? msec ju:msec
  14. include? ev.getclass ju:amiga_events
  15. include? gr.init ju:amiga_graph
  16. include? bsort ju:bsort
  17. include? choose ju:random
  18.  
  19. ANEW TASK-DEMO_GSORT
  20.  
  21. 12 constant GS_MAX
  22. GS_MAX ARRAY GS-DATA
  23.  
  24. \ Set display geometry constants.
  25. 15 constant GS_XMIN
  26. 80 constant GS_LEFT
  27. GR_XMAX constant GS_XMAX
  28. 20 constant GS_YMIN
  29. 160 constant GS_YMAX
  30. GS_YMAX GS_YMIN - GS_MAX / constant GS_DELTAY
  31.  
  32. : GS.RAND ( -- , randomize array )
  33.     gs_max 0
  34.     DO  gs_xmax gs_left - choose i gs-data !
  35.     LOOP
  36. ;
  37.  
  38. \ Draw elements of display.
  39. VARIABLE GS-I
  40. : GS.CALCY ( i -- )
  41.     gs_deltay * gs_ymin +
  42. ;
  43.  
  44. : GS.#.  ( i -- , print value of data )
  45.     dup gs-i ! 1+ gs.calcy 1-  ( calc y )
  46.     gs_xmin swap gr.move
  47.     gs-i @ gs-data @ gr.number
  48. ;
  49.  
  50. : GS.GRAPH.DATA ( i -- )
  51.     dup gs-i !
  52.     gs-data @ 3 * ( divide range into 3 colors )
  53.     gs_xmax gs_left - /  1+ gr.color!
  54.     gs_left gs-i @ gs.calcy
  55.     over gs-i @ gs-data @ +
  56.     over gs_deltay + 2-   gr.rect
  57. ;
  58.  
  59. : GS.SHOW.DATA ( i -- )
  60.     gs-i !
  61.     0 gr.color!
  62.     gs_xmin gs-i @ gs.calcy
  63.     gs_xmax over gs_deltay + 1- gr.rect
  64.     gs-i @ gs.graph.data
  65.     gs-i @ gs.#.
  66. ;
  67.  
  68. : GS.SHOW.ALL  ( -- , draw all data )
  69.     gs_max 0
  70.     DO  i gs.show.data
  71.     LOOP
  72. ;
  73.  
  74. : ADDR.EXCH?  ( a1 a2 -- , exchange if greater )
  75.     2dup @ swap @ 2dup <
  76.     IF rot !
  77.         swap !
  78.     ELSE 2drop 2drop
  79.     THEN
  80. ;
  81.  
  82. : GS.HIGHLIGHT  ( i -- , Highlight next pair. )
  83.     gs_xmin swap gs.calcy
  84.     gs_left over gs_deltay + 1- gr.highlight
  85. ;
  86.  
  87. VARIABLE GS-DELAY
  88. VARIABLE GS-QUIT
  89.  
  90. : GS.CHECK.QUIT  ( -- , set flag if closebox hit )
  91. \ Change delay if closebox hit.
  92.     ?CLOSEBOX
  93.     IF 0 gs-delay !
  94.         true gs-quit !
  95.     THEN
  96. ;
  97.  
  98. \ This the word that BSORT-EXCH? calls.
  99. : GS.EXCH? ( I1 I2 -- , exchange if [I1] > [I2] )
  100. \ Highlight two items
  101.     2dup gs.highlight gs.highlight  gs-delay @ msec
  102. \ Perform exchange.
  103.     2dup gs-data swap gs-data swap ( get addresses )
  104.     addr.exch?
  105. \ Show new order.
  106.     gs.show.data
  107.     gs.show.data
  108.     gs-delay @ msec
  109. \
  110.     gs.check.quit
  111. ;
  112.  
  113. NewWindow GSortWindow   ( Create a template for the new window. )
  114.  
  115. : GS.INIT  ( -- window )
  116.     cr ." GSORT - Hit CLOSE BOX to stop!" cr
  117.     gr.init            ( Initialize graphics system. )
  118.     GSortWindow NewWindow.Setup     ( Set defaults for window )
  119.     180 GSortWindow ..! nw_height
  120. \ Create window from template and make it the current window.
  121.     GSortWindow  gr.opencurw
  122. \ Change this for different sorts.
  123.     ' gs.exch? is bsort-exch?  ( Set sort vector )
  124. ;
  125.  
  126. : GS.SORT.ONCE ( -- , generate random values and sort them)
  127.     gs.rand
  128.     1 gr.color!
  129.     30 gs_ymin 4 - " Batcher's Sort Animation using JForth" gr.xytext
  130.     gs.show.all
  131.     gs-delay @ 4 * msec
  132.     gs_max bsort
  133. ;
  134.  
  135. : CHECK.DELAY  ( #msec -- , long delay but check for ?closebox )
  136.     100 / 0   \ 00002
  137.     DO  100 msec  \ 00002
  138.         gs.check.quit
  139.         gs-quit @ IF LEAVE THEN
  140.     LOOP
  141. ;
  142.  
  143. : GS.FAST.ONES  ( -- , sort four fast ones )
  144.     4 0
  145.     DO  gs.sort.once
  146.         ?closebox
  147.         IF true gs-quit !   leave
  148.         ELSE  600 msec
  149.         THEN
  150.     LOOP
  151. ;
  152.  
  153. : GSORT.LOOP ( -- , sort graphically )
  154.     false gs-quit !
  155.     BEGIN
  156. \ First Message.
  157.         gr.clear 1 gr.color!
  158.         50 50 " Batcher Sort (slowed to reveal pattern)"
  159.             gr.xytext 3000 check.delay
  160.         gs.check.quit
  161. \ One slow one.
  162.         gs-quit @ 0=
  163.         IF  200 gs-delay !
  164.             gs.sort.once
  165.         THEN
  166. \
  167. \ Second Message.
  168.         gr.clear 3 gr.color!
  169.         100 50 " Four Fast Sorts! (faster if no graphics)"
  170.             gr.xytext 3000 check.delay
  171.         gs-quit @ 0=
  172.         IF  0 gs-delay !
  173.             gs.fast.ones
  174.         THEN
  175. \
  176. \ Terminate demo?
  177.         gs-quit @ 0=
  178.         IF  600 msec
  179.             ?closebox ?terminal OR
  180.         ELSE true
  181.         THEN
  182.     UNTIL
  183. ;
  184.  
  185. : GSORT ( -- )
  186.     gs.init
  187.     IF  gsort.loop
  188.         gr.closecurw
  189.     THEN
  190.     gr.term
  191. ;
  192. cr
  193. ." Enter GSORT for demo!" cr
  194. cr
  195.